home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 3 / Gold Medal Software - Volume 3 (Gold Medal) (1994).iso / windows / editprog / newvisda.arj / VDMDI.FRM < prev    next >
Text File  |  1994-03-31  |  37KB  |  1,428 lines
  1. VERSION 2.00
  2. Begin MDIForm VDMDI 
  3.    Caption         =   "Visual Data"
  4.    ClientHeight    =   6210
  5.    ClientLeft      =   1110
  6.    ClientTop       =   1725
  7.    ClientWidth     =   9015
  8.    Height          =   6960
  9.    Icon            =   VDMDI.FRX:0000
  10.    Left            =   1020
  11.    LinkTopic       =   "MDIForm1"
  12.    Top             =   1065
  13.    Width           =   9195
  14.    Begin PictureBox Picture1 
  15.       Align           =   2  'Align Bottom
  16.       BackColor       =   &H00C0C0C0&
  17.       Height          =   240
  18.       Left            =   0
  19.       ScaleHeight     =   210
  20.       ScaleWidth      =   8985
  21.       TabIndex        =   6
  22.       Top             =   5970
  23.       Width           =   9015
  24.       Begin CommonDialog CMD1 
  25.          Left            =   8085
  26.          Top             =   0
  27.       End
  28.       Begin Label cMsg 
  29.          BackColor       =   &H00C0C0C0&
  30.          Caption         =   "Ready"
  31.          Height          =   200
  32.          Left            =   120
  33.          TabIndex        =   7
  34.          Top             =   0
  35.          Width           =   9372
  36.       End
  37.    End
  38.    Begin PictureBox ToolBar 
  39.       Align           =   1  'Align Top
  40.       BackColor       =   &H00C0C0C0&
  41.       Height          =   360
  42.       Left            =   0
  43.       ScaleHeight     =   335.077
  44.       ScaleMode       =   0  'User
  45.       ScaleWidth      =   9002.344
  46.       TabIndex        =   0
  47.       TabStop         =   0   'False
  48.       Top             =   0
  49.       Visible         =   0   'False
  50.       Width           =   9015
  51.       Begin OptionButton cDataCtl 
  52.          BackColor       =   &H00C0C0C0&
  53.          Caption         =   "Data Control"
  54.          Height          =   255
  55.          Left            =   2160
  56.          TabIndex        =   8
  57.          Top             =   30
  58.          Value           =   -1  'True
  59.          Width           =   1545
  60.       End
  61.       Begin CommandButton BeginButton 
  62.          Caption         =   "BeginTransaction"
  63.          Height          =   336
  64.          Left            =   6930
  65.          TabIndex        =   5
  66.          Top             =   0
  67.          Width           =   1812
  68.       End
  69.       Begin CommandButton RollBackButton 
  70.          Caption         =   "Rollback"
  71.          Height          =   336
  72.          Left            =   7920
  73.          TabIndex        =   4
  74.          Top             =   0
  75.          Visible         =   0   'False
  76.          Width           =   971
  77.       End
  78.       Begin CommandButton CommitButton 
  79.          Caption         =   "Commit"
  80.          Height          =   336
  81.          Left            =   6840
  82.          TabIndex        =   3
  83.          Top             =   0
  84.          Visible         =   0   'False
  85.          Width           =   971
  86.       End
  87.       Begin OptionButton cTableView 
  88.          BackColor       =   &H00C0C0C0&
  89.          Caption         =   "Grid"
  90.          Height          =   255
  91.          Left            =   5640
  92.          TabIndex        =   2
  93.          Top             =   30
  94.          Width           =   810
  95.       End
  96.       Begin OptionButton cSingleRecord 
  97.          BackColor       =   &H00C0C0C0&
  98.          Caption         =   "No Data Control"
  99.          Height          =   255
  100.          Left            =   3720
  101.          TabIndex        =   1
  102.          Top             =   30
  103.          Width           =   1800
  104.       End
  105.       Begin Label DynFormType 
  106.          BackColor       =   &H00C0C0C0&
  107.          Caption         =   "RecordSet Form Type:"
  108.          Height          =   225
  109.          Left            =   45
  110.          TabIndex        =   9
  111.          Top             =   45
  112.          Width           =   2010
  113.       End
  114.    End
  115.    Begin Menu DBMenu 
  116.       Caption         =   "&File"
  117.       Begin Menu DBOpen 
  118.          Caption         =   "&Open DataBase..."
  119.          Begin Menu DBOpen_Access 
  120.             Caption         =   "&MS Access..."
  121.          End
  122.          Begin Menu DBOpen_dBASE3 
  123.             Caption         =   "&dBASE III..."
  124.          End
  125.          Begin Menu DBOpen_dBASE4 
  126.             Caption         =   "dB&ASE IV..."
  127.          End
  128.          Begin Menu DBOpen_FoxPro 
  129.             Caption         =   "&FoxPro 2.0..."
  130.          End
  131.          Begin Menu DBOpen_Fox25 
  132.             Caption         =   "Fo&xPro 2.5..."
  133.          End
  134.          Begin Menu DBOpen_Paradox 
  135.             Caption         =   "&Paradox 3.X..."
  136.          End
  137.          Begin Menu DBOpen_Btrieve 
  138.             Caption         =   "&Btrieve..."
  139.          End
  140.          Begin Menu DBOpen_ODBC 
  141.             Caption         =   "&ODBC..."
  142.          End
  143.       End
  144.       Begin Menu DBClose 
  145.          Caption         =   "&Close DataBase"
  146.          Shortcut        =   ^C
  147.          Visible         =   0   'False
  148.       End
  149.       Begin Menu DBProperties 
  150.          Caption         =   "&Properties..."
  151.          Visible         =   0   'False
  152.       End
  153.       Begin Menu DBNew 
  154.          Caption         =   "&New..."
  155.          Begin Menu DBNew_Access 
  156.             Caption         =   "&MS Access..."
  157.          End
  158.          Begin Menu DBNew_dBASE3 
  159.             Caption         =   "&dBASE III..."
  160.          End
  161.          Begin Menu DBNew_dBASE4 
  162.             Caption         =   "dB&ASE IV..."
  163.          End
  164.          Begin Menu DBNew_FoxPro 
  165.             Caption         =   "&FoxPro 2.0..."
  166.          End
  167.          Begin Menu DBNew_Fox25 
  168.             Caption         =   "Fo&xPro 2.5..."
  169.          End
  170.          Begin Menu DBNew_Paradox 
  171.             Caption         =   "&Paradox 3.X..."
  172.          End
  173.          Begin Menu DBNew_Btrieve 
  174.             Caption         =   "&Btrieve..."
  175.          End
  176.          Begin Menu DBNew_ODBC 
  177.             Caption         =   "&ODBC..."
  178.          End
  179.       End
  180.       Begin Menu menubar1 
  181.          Caption         =   "-"
  182.       End
  183.       Begin Menu DBAbout 
  184.          Caption         =   "&About"
  185.       End
  186.       Begin Menu Exit 
  187.          Caption         =   "E&xit"
  188.          Shortcut        =   ^X
  189.       End
  190.    End
  191.    Begin Menu TblMenu 
  192.       Caption         =   "&Table"
  193.       Visible         =   0   'False
  194.       Begin Menu TblRefresh 
  195.          Caption         =   "&Refresh Table List"
  196.          Shortcut        =   ^R
  197.       End
  198.       Begin Menu TblCopyStruct 
  199.          Caption         =   "&Copy..."
  200.       End
  201.       Begin Menu TblDelete 
  202.          Caption         =   "&Delete Table"
  203.          Shortcut        =   +{DEL}
  204.       End
  205.       Begin Menu TblProperties 
  206.          Caption         =   "&Properties..."
  207.       End
  208.       Begin Menu TblAttach 
  209.          Caption         =   "&Attach..."
  210.          Visible         =   0   'False
  211.       End
  212.       Begin Menu TblZap 
  213.          Caption         =   "Remove &All Records"
  214.       End
  215.    End
  216.    Begin Menu QueryBuilder 
  217.       Caption         =   "Query!"
  218.       Visible         =   0   'False
  219.    End
  220.    Begin Menu UtilMenu 
  221.       Caption         =   "&Utility"
  222.       Visible         =   0   'False
  223.       Begin Menu UtilCloseAll 
  224.          Caption         =   "&Close All RecordSet Forms"
  225.       End
  226.       Begin Menu UtilReplace 
  227.          Caption         =   "&Global Replace..."
  228.       End
  229.       Begin Menu UtilExport 
  230.          Caption         =   "&Export to Tab Delimited File..."
  231.       End
  232.       Begin Menu menubar3 
  233.          Caption         =   "-"
  234.       End
  235.       Begin Menu UtilCompactDB 
  236.          Caption         =   "C&ompact Database"
  237.       End
  238.       Begin Menu UtilRepairDB 
  239.          Caption         =   "&Repair Database"
  240.       End
  241.    End
  242.    Begin Menu PrefMenu 
  243.       Caption         =   "&Preferences"
  244.       Begin Menu PrefOpenOnStartup 
  245.          Caption         =   "&Open Last DataBase on Startup"
  246.       End
  247.       Begin Menu menubar4 
  248.          Caption         =   "-"
  249.       End
  250.       Begin Menu PrefQueryTimeout 
  251.          Caption         =   "&Query Timeout Value..."
  252.       End
  253.       Begin Menu PrefLoginTimeout 
  254.          Caption         =   "&Login Timeout Value..."
  255.       End
  256.       Begin Menu PrefMaxRows 
  257.          Caption         =   "&Max Grid View Rows..."
  258.       End
  259.       Begin Menu menubar5 
  260.          Caption         =   "-"
  261.       End
  262.       Begin Menu PrefShowPerf 
  263.          Caption         =   "&Show Performance Numbers"
  264.       End
  265.       Begin Menu PrefAllowSys 
  266.          Caption         =   "&Include System Tables"
  267.       End
  268.       Begin Menu PrefDisplaySQL 
  269.          Caption         =   "&Display QueryDef SQL Text"
  270.       End
  271.    End
  272.    Begin Menu WinMenu 
  273.       Caption         =   "&Window"
  274.       Begin Menu WinTile 
  275.          Caption         =   "&Tile"
  276.       End
  277.       Begin Menu WinCascade 
  278.          Caption         =   "&Cascade"
  279.       End
  280.       Begin Menu WinArrange 
  281.          Caption         =   "&Arrange Icons"
  282.       End
  283.       Begin Menu menubar2 
  284.          Caption         =   "-"
  285.       End
  286.       Begin Menu WinTables 
  287.          Caption         =   "Ta&bles"
  288.          Shortcut        =   ^T
  289.       End
  290.       Begin Menu WinSQL 
  291.          Caption         =   "&SQL"
  292.          Shortcut        =   ^S
  293.       End
  294.    End
  295. End
  296. Option Explicit
  297. Option Compare Binary
  298.  
  299. Sub BeginButton_Click ()
  300.   On Error GoTo BeginErr
  301.  
  302.   If gCurrentDB.Transactions = False Then
  303.     Beep
  304.     MsgBox "Transactions not supported by this Driver!"
  305.     Exit Sub
  306.   End If
  307.   gCurrentDB.BeginTrans
  308.   gfDBChanged = False
  309.   gfTransPending = True
  310.   BeginButton.Visible = False
  311.   CommitButton.Visible = True
  312.   RollBackButton.Visible = True
  313.   CommitButton.SetFocus
  314.  
  315.   GoTo BeginTransEnd
  316.  
  317. BeginErr:
  318.   ShowError
  319.   Resume BeginTransEnd
  320.  
  321. BeginTransEnd:
  322.  
  323. End Sub
  324.  
  325. Sub CommitButton_Click ()
  326.   On Error GoTo CommitErr
  327.  
  328.   gCurrentDB.CommitTrans
  329.   gfDBChanged = False
  330.   gfTransPending = False
  331.   BeginButton.Visible = True
  332.   CommitButton.Visible = False
  333.   RollBackButton.Visible = False
  334.   BeginButton.SetFocus
  335.  
  336.   GoTo DBCommitTransEnd
  337.  
  338. CommitErr:
  339.   ShowError
  340.   Resume DBCommitTransEnd
  341.  
  342. DBCommitTransEnd:
  343.  
  344. End Sub
  345.  
  346. Sub DBAbout_Click ()
  347.   MsgBar "Press any key to Close About Box", False
  348.   AboutBox.Show MODAL
  349.   MsgBar "", False
  350. End Sub
  351.  
  352. Sub DBClose_Click ()
  353.   On Error GoTo DBCloseErr
  354.  
  355.   If gfDBChanged Then
  356.     If MsgBox("Data has been changed, Commit it?", MSGBOX_TYPE) = YES Then
  357.       gCurrentDB.CommitTrans
  358.       gfDBChanged = False
  359.     Else
  360.       If MsgBox("RollBack All changes?", MSGBOX_TYPE) = YES Then
  361.         gCurrentDB.Rollback
  362.         gfDBChanged = False
  363.       Else
  364.         Beep
  365.         MsgBox "Can't Close with Transactions Pending!", 48
  366.         Exit Sub
  367.       End If
  368.     End If
  369.   End If
  370.  
  371.   gTableListSS.Close
  372.   CloseAllDynasets
  373.   gCurrentDB.Close
  374.  
  375.   fTables.Caption = "<none>"
  376.   fTables.cTableList.Clear
  377.   fTables.TableListLabel = "Tables:"
  378.   DBProperties.Visible = False
  379.   DBClose.Visible = False
  380.   TblAttach.Visible = False
  381.   TblMenu.Visible = False
  382.   UtilMenu.Visible = False
  383.   ToolBar.Visible = False
  384.   QueryBuilder.Visible = False
  385.  
  386.   gfDBOpenFlag = False
  387.   gfTransPending = False
  388.   gstDBName = ""
  389.  
  390.   Unload fQuery
  391.  
  392.   GoTo DBCloseEnd
  393.  
  394. DBCloseErr:
  395.   ShowError
  396.   Resume DBCloseEnd
  397.  
  398. DBCloseEnd:
  399.  
  400. End Sub
  401.  
  402. Sub DBNew_Access_Click ()
  403.    Dim nn As String
  404.    Dim d As Database
  405.    Dim v10 As Integer
  406.    On Error GoTo NewAccErr
  407.   
  408.  
  409.    nn = InputBox("Enter Name for New MS Access Database:")
  410.    If nn = "" Then Exit Sub
  411.  
  412.    If MsgBox("Make New Database Access 1.0 Compatible?", MSGBOX_TYPE) = YES Then
  413.      Set d = CreateDatabase(nn, DB_CREATE_GENERAL, DB_VERSION10)
  414.    Else
  415.      Set d = CreateDatabase(nn, DB_CREATE_GENERAL, 0)
  416.    End If
  417.    d.Close
  418.  
  419.    gstDataType = "MS Access"
  420.    gstDBName = nn
  421.    OpenLocalDB True
  422.  
  423.    If gfDBOpenFlag = True Then
  424.      DBProperties.Visible = True
  425.      DBClose.Visible = True
  426.      TblMenu.Visible = True
  427.      UtilMenu.Visible = True
  428.      RefreshTables fTables.cTableList, True
  429.      fSQL.CreateQueryDefbtn.Visible = True
  430.      TblAttach.Visible = True
  431.    End If
  432.   
  433.   GoTo NewAccEnd
  434. NewAccErr:
  435.   ShowError
  436.   Resume NewAccEnd
  437.  
  438. NewAccEnd:
  439.  
  440. End Sub
  441.  
  442. Sub DBNew_Btrieve_Click ()
  443.    gstDataType = "Btrieve"
  444.    NewLocalISAM
  445. End Sub
  446.  
  447. Sub DBNew_dBASE3_Click ()
  448.    gstDataType = "dBASE III"
  449.    NewLocalISAM
  450. End Sub
  451.  
  452. Sub DBNew_dBASE4_Click ()
  453.    gstDataType = "dBASE IV"
  454.    NewLocalISAM
  455. End Sub
  456.  
  457. Sub DBNew_FoxPro_Click ()
  458.    gstDataType = "FoxPro 2.0"
  459.    NewLocalISAM
  460. End Sub
  461.  
  462. Sub DBNew_ODBC_Click ()
  463.   Dim driver As String
  464.  
  465.   On Error GoTo DBNErr
  466.   MsgBar "Enter New Database Parameters", False
  467.  
  468.   'driver must be an valid entry in ODBCINST.INI
  469.   driver = InputBox("Enter Driver Name from ODBCINST.INI File:", "Driver Name", DEFAULTDRIVER)
  470.  
  471.   RegisterDatabase "", driver, False, ""
  472.  
  473.   SendKeys "%FOO"   'force open database dialog
  474.  
  475.   GoTo DBNEnd
  476.  
  477. DBNErr:
  478.   ShowError
  479.   Resume DBNEnd
  480.  
  481. DBNEnd:
  482.   MsgBar "", False
  483.  
  484.  
  485. End Sub
  486.  
  487. Sub DBNew_Paradox_Click ()
  488.    gstDataType = "Paradox 3.X"
  489.    NewLocalISAM
  490. End Sub
  491.  
  492. Sub DBOpen_Access_Click ()
  493.    gstDataType = "MS Access"
  494.    OpenLocalDB False
  495. End Sub
  496.  
  497. Sub DBOpen_Btrieve_Click ()
  498.    gstDataType = "Btrieve"
  499.    OpenLocalDB False
  500. End Sub
  501.  
  502. Sub DBOpen_dBASE3_Click ()
  503.    gstDataType = "dBASE III"
  504.    OpenLocalDB False
  505. End Sub
  506.  
  507. Sub DBOpen_dBASE4_Click ()
  508.    gstDataType = "dBASE IV"
  509.    OpenLocalDB False
  510. End Sub
  511.  
  512. Sub DBOpen_Fox25_Click ()
  513.    gstDataType = "FoxPro 2.5"
  514.    OpenLocalDB False
  515. End Sub
  516.  
  517. Sub DBOpen_FoxPro_Click ()
  518.    gstDataType = "FoxPro 2.0"
  519.    OpenLocalDB False
  520. End Sub
  521.  
  522. Sub DBOpen_ODBC_Click ()
  523.    If gfDBOpenFlag = True Then
  524.      Call DBClose_Click
  525.    End If
  526.   
  527.    If gfDBOpenFlag = True Then
  528.      Beep
  529.      MsgBox "You must Close First!", 48
  530.    Else
  531.      fOpenDB.Show MODAL
  532.    End If
  533.  
  534.    If gfDBOpenFlag = True Then
  535.      DBProperties.Visible = True
  536.      DBClose.Visible = True
  537.      TblMenu.Visible = True
  538.      UtilMenu.Visible = True
  539.      RefreshTables fTables.cTableList, True
  540.      fSQL.CreateQueryDefbtn.Visible = False
  541.      TblAttach.Visible = False
  542.    End If
  543. End Sub
  544.  
  545. Sub DBOpen_Paradox_Click ()
  546.    gstDataType = "Paradox 3.X"
  547.    OpenLocalDB False
  548. End Sub
  549.  
  550. Sub DBProperties_Click ()
  551.    Dim f As New fDataBox
  552.    Dim s As String, t As String, erm As String
  553.    Dim i As Integer
  554.  
  555.    On Error GoTo PropErr
  556.  
  557.    f.Caption = gCurrentDB.Name + " Properties"
  558.    f.Tag = "DB"
  559.  
  560.    erm = "Name"
  561.    f.cData.AddItem "Database Name = " + gCurrentDB.Name
  562.    erm = "Connect"
  563.    f.cData.AddItem "Connect String = " + gCurrentDB.Connect
  564.  
  565.    erm = "Collating Order"
  566.    f.cData.AddItem "Collating Order = " + gCurrentDB.CollatingOrder
  567.    erm = "Updatable"
  568.    f.cData.AddItem "Updatable = " + stTrueFalse((gCurrentDB.Updatable))
  569.    erm = "Transactions"
  570.    f.cData.AddItem "Transactions = " + stTrueFalse((gCurrentDB.Transactions))
  571.    erm = "QueryTimeout"
  572.    f.cData.AddItem "Query Timeout = " & gCurrentDB.QueryTimeout & " seconds"
  573.  
  574.    f.Show MODAL
  575.  
  576.   GoTo DBPropEnd
  577.  
  578. PropErr:
  579.   f.cData.AddItem erm + ":" + Error$
  580.   Resume Next
  581.  
  582. DBPropEnd:
  583.  
  584. End Sub
  585.  
  586. Sub Exit_Click ()
  587.   Unload Me
  588. End Sub
  589.  
  590. Sub MDIForm_Load ()
  591.   Dim st As String
  592.   Dim x As Integer
  593.  
  594.   Dim tmp As String
  595.  
  596.   tmp = String$(255, 32)
  597.  
  598.   'write ISAM entries in INI file just in case
  599.   x = OSWritePrivateProfileString("Installable ISAMS", "Paradox 3.X", "PDX110.DLL", "VISDATA.INI")
  600.   x = OSWritePrivateProfileString("Installable ISAMS", "dBASE III", "XBS110.DLL", "VISDATA.INI")
  601.   x = OSWritePrivateProfileString("Installable ISAMS", "dBASE IV", "XBS110.DLL", "VISDATA.INI")
  602.   x = OSWritePrivateProfileString("Installable ISAMS", "FoxPro 2.0", "XBS110.DLL", "VISDATA.INI")
  603.   x = OSWritePrivateProfileString("Installable ISAMS", "FoxPro 2.5", "XBS110.DLL", "VISDATA.INI")
  604.   x = OSWritePrivateProfileString("Installable ISAMS", "Btrieve", "BTRV110.DLL", "VISDATA.INI")
  605.   x = OSWritePrivateProfileString("dBase ISAM", "Deleted", "On", "VISDATA.INI")
  606.  
  607.   x = OSGetWindowsDirectory(tmp, 255)
  608.   st = Mid$(tmp, 1, x)
  609.   SetDataAccessOption 1, st + "\visdata.ini"
  610.  
  611.  
  612.  
  613.   gwMaxGridRows = Val(GetINIString("MaxRows", "250"))
  614.   glQueryTimeout = Val(GetINIString("QueryTimeout", "5"))
  615.   glLoginTimeout = Val(GetINIString("LoginTimeout", "20"))
  616.   st = GetINIString("ViewMode", "Single")
  617.   If UCase(st) = "SINGLE" Then
  618.     cSingleRecord = True
  619.   ElseIf UCase(st) = "DATACTL" Then
  620.     cDataCtl = True
  621.   Else
  622.     cTableView = True
  623.   End If
  624.   st = GetINIString("OpenOnStartup", "No")
  625.   If UCase(st) = "YES" Then
  626.     PrefOpenOnStartup.Checked = True
  627.   Else
  628.     PrefOpenOnStartup.Checked = False
  629.   End If
  630.   st = GetINIString("ShowPerf", "No")
  631.   If UCase(st) = "YES" Then
  632.     PrefShowPerf.Checked = True
  633.   Else
  634.     PrefShowPerf.Checked = False
  635.   End If
  636.   st = GetINIString("AllowSys", "No")
  637.   If UCase(st) = "YES" Then
  638.     PrefAllowSys.Checked = True
  639.   Else
  640.     PrefAllowSys.Checked = False
  641.   End If
  642.   st = GetINIString("DisplaySQL", "No")
  643.   If UCase(st) = "YES" Then
  644.     PrefDisplaySQL.Checked = True
  645.   Else
  646.     PrefDisplaySQL.Checked = False
  647.   End If
  648.   'get the last used database out of the INI file
  649.   gstDataType = GetINIString("DataType", "")
  650.   gstDBName = GetINIString("Server", "")
  651.   gstDatabase = GetINIString("DataBase", "")
  652.   gstUserName = GetINIString("UserName", "")
  653.   gstPassword = GetINIString("Password", "")
  654.  
  655.   If PrefOpenOnStartup.Checked = True Then
  656.     If gstDataType = "MS Access" Then
  657.       SendKeys "%FOM"
  658.     ElseIf gstDataType = "dBASE III" Then
  659.       SendKeys "%FOD"
  660.     ElseIf gstDataType = "dBASE IV" Then
  661.       SendKeys "%FOA"
  662.     ElseIf gstDataType = "FoxPro 2.0" Then
  663.       SendKeys "%FOF"
  664.     ElseIf gstDataType = "FoxPro 2.5" Then
  665.       SendKeys "%FOX"
  666.     ElseIf gstDataType = "Paradox 3.X" Then
  667.       SendKeys "%FOP"
  668.     ElseIf gstDataType = "Btrieve" Then
  669.       SendKeys "%FOB"
  670.     ElseIf gstDataType = "ODBC" Then
  671.       SendKeys "%FOO"
  672.     End If
  673.   End If
  674.  
  675.   x = Val(GetINIString("WindowState", "2"))
  676.   If x <> 1 Then
  677.     WindowState = x
  678.   Else
  679.     WindowState = 0
  680.   End If
  681.   If x = 0 Then
  682.     x = Val(GetINIString("WindowLeft", "0"))
  683.     Left = x
  684.     x = Val(GetINIString("WindowTop", "0"))
  685.     Top = x
  686.     x = Val(GetINIString("WindowWidth", "9135"))
  687.     Width = x
  688.     x = Val(GetINIString("WindowHeight", "6900"))
  689.     Height = x
  690.   End If
  691.   Me.Show
  692.  
  693.   fSQL.Show
  694.  
  695. End Sub
  696.  
  697. Sub MDIForm_QueryUnload (Cancel As Integer, UnloadMode As Integer)
  698.   Dim x As Integer
  699.   Dim st As String
  700.  
  701.   On Error Resume Next
  702.  
  703.   x = OSWritePrivateProfileString("VISDATA", "DataType", gstDataType, "VISDATA.INI")
  704.   x = OSWritePrivateProfileString("VISDATA", "Server", gstDBName, "VISDATA.INI")
  705.   x = OSWritePrivateProfileString("VISDATA", "DataBase", gstDatabase, "VISDATA.INI")
  706.   x = OSWritePrivateProfileString("VISDATA", "UserName", gstUserName, "VISDATA.INI")
  707.   x = OSWritePrivateProfileString("VISDATA", "Password", gstPassword, "VISDATA.INI")
  708.  
  709.   If PrefOpenOnStartup.Checked = True Then
  710.     st = "Yes"
  711.   Else
  712.     st = "No"
  713.   End If
  714.   x = OSWritePrivateProfileString("VISDATA", "OpenOnStartup", st, "VISDATA.INI")
  715.   If PrefShowPerf.Checked = True Then
  716.     st = "Yes"
  717.   Else
  718.     st = "No"
  719.   End If
  720.   x = OSWritePrivateProfileString("VISDATA", "ShowPerf", st, "VISDATA.INI")
  721.   If PrefAllowSys.Checked = True Then
  722.     st = "Yes"
  723.   Else
  724.     st = "No"
  725.   End If
  726.   x = OSWritePrivateProfileString("VISDATA", "DisplaySQL", st, "VISDATA.INI")
  727.   If PrefDisplaySQL.Checked = True Then
  728.     st = "Yes"
  729.   Else
  730.     st = "No"
  731.   End If
  732.   x = OSWritePrivateProfileString("VISDATA", "AllowSys", st, "VISDATA.INI")
  733.  
  734.   x = OSWritePrivateProfileString("VISDATA", "WindowState", CStr(WindowState), "VISDATA.INI")
  735.   If WindowState <> 2 Then
  736.     x = OSWritePrivateProfileString("VISDATA", "WindowTop", CStr(Top), "VISDATA.INI")
  737.     x = OSWritePrivateProfileString("VISDATA", "WindowLeft", CStr(Left), "VISDATA.INI")
  738.     x = OSWritePrivateProfileString("VISDATA", "WindowWidth", CStr(Width), "VISDATA.INI")
  739.     x = OSWritePrivateProfileString("VISDATA", "WindowHeight", CStr(Height), "VISDATA.INI")
  740.   End If
  741.  
  742.   x = OSWritePrivateProfileString("VISDATA", "MaxRows", CStr(gwMaxGridRows), "VISDATA.INI")
  743.   x = OSWritePrivateProfileString("VISDATA", "QueryTimeout", CStr(glQueryTimeout), "VISDATA.INI")
  744.   x = OSWritePrivateProfileString("VISDATA", "LoginTimeout", CStr(glLoginTimeout), "VISDATA.INI")
  745.   If VDMDI.cSingleRecord = True Then
  746.     st = "Single"
  747.   ElseIf VDMDI.cDataCtl = True Then
  748.     st = "DataCtl"
  749.   Else
  750.     st = "Table"
  751.   End If
  752.   x = OSWritePrivateProfileString("VISDATA", "ViewMode", st, "VISDATA.INI")
  753.  
  754.   x = OSWritePrivateProfileString("VISDATA", "SQLStatement", fSQL.cSQLStatement, "VISDATA.INI")
  755.   If fSQL.WindowState <> 1 Then
  756.     x = OSWritePrivateProfileString("VISDATA", "SQLWindowTop", CStr(fSQL.Top), "VISDATA.INI")
  757.     x = OSWritePrivateProfileString("VISDATA", "SQLWindowLeft", CStr(fSQL.Left), "VISDATA.INI")
  758.     x = OSWritePrivateProfileString("VISDATA", "SQLWindowWidth", CStr(fSQL.Width), "VISDATA.INI")
  759.     x = OSWritePrivateProfileString("VISDATA", "SQLWindowHeight", CStr(fSQL.Height), "VISDATA.INI")
  760.   End If
  761.  
  762.   If gfDBChanged Then
  763.     If MsgBox("Data has been changed, Commit it?", MSGBOX_TYPE) = YES Then
  764.       gCurrentDB.CommitTrans
  765.     End If
  766.   End If
  767.  
  768.   CloseAllDynasets
  769.   If gfDBOpenFlag Then gCurrentDB.Close
  770.  
  771.   End
  772. End Sub
  773.  
  774. Sub NewLocalISAM ()
  775.    Dim nn As String
  776.    Dim d As Database
  777.    On Error GoTo NewISAMErr
  778.   
  779.  
  780.    nn = InputBox("Enter Name for New ISAM Database:")
  781.    If nn = "" Then Exit Sub
  782.  
  783.    If Mid(nn, Len(nn), 1) <> "\" Then nn = nn + "\"
  784.  
  785.    MkDir Mid(nn, 1, Len(nn) - 1)
  786.  
  787.    gstDBName = nn
  788.    OpenLocalDB True
  789.  
  790.    If gfDBOpenFlag = True Then
  791.      DBProperties.Visible = True
  792.      DBClose.Visible = True
  793.      TblMenu.Visible = True
  794.      UtilMenu.Visible = True
  795.      RefreshTables fTables.cTableList, True
  796.      fSQL.CreateQueryDefbtn.Visible = True
  797.      TblAttach.Visible = True
  798.    End If
  799.   
  800.   GoTo NewISAMEnd
  801. NewISAMErr:
  802.   If Err = 75 Then Resume Next  'catch the case where dir exists
  803.   ShowError
  804.   Resume NewISAMEnd
  805.  
  806. NewISAMEnd:
  807.  
  808. End Sub
  809.  
  810. Sub OpenLocalDB (doit As Integer)
  811.    Dim Connect As String, DataBaseName As String
  812.  
  813.    On Error GoTo OpenError
  814.  
  815.    If gfDBOpenFlag = True Then
  816.      Call DBClose_Click
  817.    End If
  818.   
  819.    If gfDBOpenFlag = True Then
  820.      Beep
  821.      MsgBox "You must Close First!", 48
  822.      Exit Sub
  823.    Else
  824.      Select Case gstDataType
  825.        Case "MS Access"
  826.          CMD1.Filter = "Access DBs (*.mdb)|*.mdb|All Files (*.*)|*.*"
  827.          CMD1.DialogTitle = "Open MS Access Database"
  828.        Case "dBASE III"
  829.          CMD1.Filter = "dBASE III DBs (*.dbf)|*.dbf"
  830.          CMD1.DialogTitle = "Open dBASE III Database"
  831.        Case "dBASE IV"
  832.          CMD1.Filter = "dBASE IV DBs (*.dbf)|*.dbf"
  833.          CMD1.DialogTitle = "Open dBASE IV Database"
  834.        Case "FoxPro 2.0"
  835.          CMD1.Filter = "FoxPro DBs (*.dbf)|*.dbf"
  836.          CMD1.DialogTitle = "Open FoxPro 2.0 Database"
  837.        Case "FoxPro 2.5"
  838.          CMD1.Filter = "FoxPro DBs (*.dbf)|*.dbf"
  839.          CMD1.DialogTitle = "Open FoxPro 2.5 Database"
  840.        Case "Paradox 3.X"
  841.          CMD1.Filter = "Paradox DBs (*.db)|*.db"
  842.          CMD1.DialogTitle = "Open Paradox 3.X Database"
  843.        Case "Btrieve"
  844.          CMD1.Filter = "Btrieve DBs (FILE.DDF)|FILE.DDF"
  845.          CMD1.DialogTitle = "Open Btrieve Database"
  846.      End Select
  847.  
  848.      CMD1.FilterIndex = 1
  849.      CMD1.Filename = gstDBName  '""
  850.      CMD1.CancelError = True
  851.  
  852.      If doit = False Then
  853.        CMD1.Action = 1
  854.  
  855.        If CMD1.Filename <> "" Then
  856.          gstDBName = CMD1.Filename
  857.        Else
  858.          Exit Sub
  859.        End If
  860.      End If
  861.    End If
  862.  
  863.  
  864.    MsgBar "Opening DataBase", True
  865.  
  866.    SetHourGlass Me
  867.  
  868.    Select Case gstDataType
  869.      Case "dBASE III"
  870.        Connect = "dBASE III"
  871.        DataBaseName = StripFileName(gstDBName)
  872.      Case "dBASE IV"
  873.        Connect = "dBASE IV"
  874.        DataBaseName = StripFileName(gstDBName)
  875.      Case "FoxPro 2.0"
  876.        Connect = "FoxPro 2.0"
  877.        DataBaseName = StripFileName(gstDBName)
  878.      Case "FoxPro 2.5"
  879.        Connect = "FoxPro 2.5"
  880.        DataBaseName = StripFileName(gstDBName)
  881.      Case "Paradox 3.X"
  882.        Connect = "Paradox 3.X"
  883.        DataBaseName = StripFileName(gstDBName)
  884.      Case "Btrieve"
  885.        Connect = "Btrieve;"
  886.        DataBaseName = gstDBName
  887.      Case Else
  888.        Connect = ""
  889.        DataBaseName = gstDBName
  890.    End Select
  891.  
  892.    Set gCurrentDB = OpenDatabase(DataBaseName, False, False, Connect)
  893.    If gfDBOpenFlag = True Then
  894.      CloseAllDynasets
  895.    End If
  896.    gfTransPending = False
  897.    VDMDI.ToolBar.Visible = True
  898.    VDMDI.QueryBuilder.Visible = True
  899.  
  900.    fTables.Caption = gstDBName
  901.    gCurrentDB.QueryTimeout = glQueryTimeout
  902.  
  903.    'success
  904.    gfDBOpenFlag = True
  905.    DBProperties.Visible = True
  906.    DBClose.Visible = True
  907.    TblMenu.Visible = True
  908.    UtilMenu.Visible = True
  909.    RefreshTables fTables.cTableList, True
  910.    If gstDataType = "MS Access" Then
  911.      fSQL.CreateQueryDefbtn.Visible = True
  912.      TblAttach.Visible = True
  913.      fTables.TableListLabel = "Tables/Queries:"
  914.    Else
  915.      TblAttach.Visible = False
  916.      fSQL.CreateQueryDefbtn.Visible = False
  917.    End If
  918.  
  919.    ResetMouse Me
  920.    
  921.    GoTo OpenEnd
  922.  
  923. OpenError:
  924.    ResetMouse Me
  925.    gfDBOpenFlag = False
  926.    gstDBName = ""
  927.    gstDataType = ""
  928.    If Err <> 32755 Then     'check for common dialog cancelled
  929.      ShowError
  930.    End If
  931.    Resume OpenEnd
  932.  
  933. OpenEnd:
  934.  
  935. End Sub
  936.  
  937. Sub PrefAllowSys_Click ()
  938.   If PrefAllowSys.Checked = True Then
  939.     PrefAllowSys.Checked = False
  940.   Else
  941.     PrefAllowSys.Checked = True
  942.   End If
  943.   RefreshTables fTables.cTableList, True
  944. End Sub
  945.  
  946. Sub PrefDisplaySQL_Click ()
  947.   If PrefDisplaySQL.Checked = True Then
  948.     PrefDisplaySQL.Checked = False
  949.   Else
  950.     PrefDisplaySQL.Checked = True
  951.   End If
  952. End Sub
  953.  
  954. Sub PrefLoginTimeout_Click ()
  955.   On Error GoTo LTErr
  956.   Dim nval As String
  957.   
  958.   nval = InputBox("Login Timeout is currently " & glLoginTimeout & " seconds." + Chr(13) + Chr(10) + "Enter New Value:")
  959.   If nval = "" Then Exit Sub
  960.  
  961.   'try to set the new value
  962.   If Val(nval) >= 0 Then
  963.     glLoginTimeout = Val(nval)
  964.   End If
  965.  
  966.   GoTo LTEnd
  967.  
  968. LTErr:
  969.   ShowError
  970.   Resume LTEnd
  971.  
  972. LTEnd:
  973.  
  974. End Sub
  975.  
  976. Sub PrefMaxRows_Click ()
  977.   Dim st As String
  978.   Dim CR As String
  979.  
  980.   MsgBar "Enter Maximum Rows to Show in Grid", False
  981.  
  982.   st = InputBox("Enter New Value:", "Max Grid View Rows", CStr(gwMaxGridRows))
  983.  
  984.   If st <> "" Then
  985.     If Val(st) > MAX_GRID_ROWS Then
  986.       MsgBox "Maximum Rows is " + CStr(MAX_GRID_ROWS), 48
  987.       gwMaxGridRows = MAX_GRID_ROWS
  988.     ElseIf Val(st) = 0 Then
  989.       MsgBox "Minimum Rows is 1.", 48
  990.       gwMaxGridRows = 1
  991.     Else
  992.       gwMaxGridRows = Val(st)
  993.     End If
  994.   End If
  995.  
  996.   MsgBar "", False
  997. End Sub
  998.  
  999. Sub PrefOpenOnStartup_Click ()
  1000.   'toggle the menu item
  1001.   If PrefOpenOnStartup.Checked = True Then
  1002.     PrefOpenOnStartup.Checked = False
  1003.   Else
  1004.     PrefOpenOnStartup.Checked = True
  1005.   End If
  1006. End Sub
  1007.  
  1008. Sub PrefQueryTimeout_Click ()
  1009.   On Error GoTo QTErr
  1010.   Dim nval As String
  1011.   
  1012.   nval = InputBox("Query Timeout is currently " & gCurrentDB.QueryTimeout & " seconds." + Chr(13) + Chr(10) + "Enter New Value:")
  1013.   If nval = "" Then Exit Sub
  1014.  
  1015.   'try to set the new value
  1016.   gCurrentDB.QueryTimeout = Val(nval)
  1017.   glQueryTimeout = Val(nval)
  1018.  
  1019.   GoTo QTEnd
  1020.  
  1021. QTErr:
  1022.   ShowError
  1023.   'reset the form control after the error
  1024.   glQueryTimeout = gCurrentDB.QueryTimeout
  1025.   Resume QTEnd
  1026.  
  1027. QTEnd:
  1028.  
  1029. End Sub
  1030.  
  1031. Sub PrefShowPerf_Click ()
  1032.   If PrefShowPerf.Checked = True Then
  1033.     PrefShowPerf.Checked = False
  1034.   Else
  1035.     PrefShowPerf.Checked = True
  1036.   End If
  1037. End Sub
  1038.  
  1039. Sub QueryBuilder_Click ()
  1040.   fQuery.WindowState = 0
  1041. End Sub
  1042.  
  1043. Sub RollBackButton_Click ()
  1044.   On Error GoTo RollbackErr
  1045.  
  1046.   If MsgBox("All changes will be gone, Rollback anyway?", MSGBOX_TYPE) = YES Then
  1047.     gCurrentDB.Rollback
  1048.     gfDBChanged = False
  1049.     gfTransPending = False
  1050.     BeginButton.Visible = True
  1051.     CommitButton.Visible = False
  1052.     RollBackButton.Visible = False
  1053.     BeginButton.SetFocus
  1054.   End If
  1055.  
  1056.   GoTo DBRollbackEnd
  1057.  
  1058. RollbackErr:
  1059.   ShowError
  1060.   Resume DBRollbackEnd
  1061.  
  1062. DBRollbackEnd:
  1063.  
  1064. End Sub
  1065.  
  1066. Sub TblAttach_Click ()
  1067.   fAttach.Show MODAL
  1068. End Sub
  1069.  
  1070. Sub TblCopyStruct_Click ()
  1071.   fCpyStru.Show MODAL
  1072. End Sub
  1073.  
  1074. Sub TblDelete_Click ()
  1075.   On Error GoTo TblDelErr
  1076.  
  1077.   If fTables.cTableList = "" Then
  1078.     MsgBox "No Table Selected", 48
  1079.     Exit Sub
  1080.   End If
  1081.  
  1082.   If MsgBox("Delete """ + fTables.cTableList + """ table?", MSGBOX_TYPE) = YES Then
  1083.     If TableType((fTables.cTableList)) = DB_QUERYDEF Then
  1084.       gCurrentDB.DeleteQueryDef (fTables.cTableList)
  1085.     Else
  1086.       gCurrentDB.TableDefs.Delete gCurrentDB.TableDefs(fTables.cTableList)
  1087.     End If
  1088.     fTables.cTableList.RemoveItem fTables.cTableList.ListIndex
  1089.   End If
  1090.  
  1091.   GoTo TblDelEnd
  1092.  
  1093. TblDelErr:
  1094.   ShowError
  1095.   Resume TblDelEnd
  1096.  
  1097. TblDelEnd:
  1098.  
  1099. End Sub
  1100.  
  1101. Sub TblProperties_Click ()
  1102.    Dim f As New fDataBox
  1103.    Dim erm As String
  1104.    Dim tt As Integer
  1105.    Dim qt As String
  1106.    Dim qd As querydef
  1107.  
  1108.    If fTables.cTableList = "" Then
  1109.      MsgBox "No Table Selected", 48
  1110.      Exit Sub
  1111.    End If
  1112.  
  1113.    On Error GoTo TblPropErr
  1114.  
  1115.    f.Caption = fTables.cTableList + " Properties"
  1116.  
  1117.    tt = TableType((fTables.cTableList))
  1118.    If tt = DB_QUERYDEF Then
  1119.      f.cData.AddItem "Table Type = QueryDef"
  1120.    ElseIf tt = DB_ATTACHEDTABLE Then
  1121.      f.cData.AddItem "Table Type = Attached Table"
  1122.    ElseIf tt = DB_ATTACHEDODBC Then
  1123.      f.cData.AddItem "Table Type = Attached ODBC Table"
  1124.    Else
  1125.      f.cData.AddItem "Table Type = Table"
  1126.    End If
  1127.  
  1128.    If tt = DB_QUERYDEF Then
  1129.      f.Tag = "QD"
  1130.      Set gCurrentQueryDef = gCurrentDB.OpenQueryDef(fTables.cTableList)
  1131.      erm = "Name"
  1132.      f.cData.AddItem "QueryDef Name = " + gCurrentQueryDef.Name
  1133.      erm = "SQL"
  1134.      f.cData.AddItem "SQL = " + gCurrentQueryDef.SQL
  1135.      qt = ActionQueryType((fTables.cTableList))
  1136.      If qt <> "" Then
  1137.        f.cData.AddItem "Action Query Type = " + qt
  1138.      End If
  1139.      f.Show MODAL
  1140.      gCurrentQueryDef.Close
  1141.    Else
  1142.      f.Tag = "TBD"
  1143.      erm = "Name"
  1144.      f.cData.AddItem "Table Name = " + gCurrentDB.TableDefs(fTables.cTableList).Name
  1145.      erm = "Date Created"
  1146.      f.cData.AddItem "Date Created = " & gCurrentDB.TableDefs(fTables.cTableList).DateCreated
  1147.      erm = "Last Updated"
  1148.      f.cData.AddItem "Last Updated = " & gCurrentDB.TableDefs(fTables.cTableList).LastUpdated
  1149.      erm = "Updatable"
  1150.      f.cData.AddItem "Updatable = " + stTrueFalse((gCurrentDB.TableDefs(fTables.cTableList).Updatable))
  1151.      erm = "Connect"
  1152.      f.cData.AddItem "Connect String = " + gCurrentDB.TableDefs(fTables.cTableList).Connect
  1153.      erm = "Source Table Name"
  1154.      f.cData.AddItem "Source Table Name = " + gCurrentDB.TableDefs(fTables.cTableList).SourceTableName
  1155.      erm = "Attributes"
  1156.      f.cData.AddItem "Attributes = &H" & Hex(gCurrentDB.TableDefs(fTables.cTableList).Attributes)
  1157.      f.Show MODAL
  1158.    End If
  1159.  
  1160.   GoTo TblPropEnd
  1161.  
  1162. TblPropErr:
  1163.   f.cData.AddItem erm + ":" + Error$
  1164.   Resume Next
  1165.  
  1166. TblPropEnd:
  1167.  
  1168. End Sub
  1169.  
  1170. Sub TblRefresh_Click ()
  1171.   gCurrentDB.TableDefs.Refresh
  1172.   RefreshTables fTables.cTableList, True
  1173. End Sub
  1174.  
  1175. Sub TblZap_Click ()
  1176.   Dim RetSQL As Long
  1177.  
  1178.   If fTables.cTableList = "" Then
  1179.     MsgBox "No Table Selected", 48
  1180.     Exit Sub
  1181.   End If
  1182.  
  1183.   On Error GoTo ZapErr
  1184.  
  1185.   If MsgBox("Delete All Records in " + fTables.cTableList + "?", MSGBOX_TYPE) = YES Then
  1186.     'delete all rows with a sql statement
  1187.     If gstDataType = "ODBC" Then
  1188.       RetSQL = gCurrentDB.ExecuteSQL("delete from " + fTables.cTableList)
  1189.       If RetSQL > 0 Then
  1190.         MsgBox CStr(RetSQL) + " rows deleted!", 48
  1191.         If gfTransPending Then gfDBChanged = True
  1192.       End If
  1193.     Else
  1194.       gCurrentDB.Execute ("delete from " + fTables.cTableList)
  1195.     End If
  1196.   End If
  1197.  
  1198.   GoTo ZapEnd
  1199.  
  1200. ZapErr:
  1201.   If Err = EOF_ERR Then Resume Next
  1202.   ShowError
  1203.   Resume ZapEnd
  1204.  
  1205. ZapEnd:
  1206.  
  1207. End Sub
  1208.  
  1209. Sub UtilCloseAll_Click ()
  1210.   CloseAllDynasets
  1211. End Sub
  1212.  
  1213. Sub UtilCompactDB_Click ()
  1214.    Dim oldname As String, newname As String
  1215.    On Error GoTo CompactAccErr
  1216.   
  1217.    'get file name to compact
  1218.    CMD1.Filter = "Access DBs (*.mdb)|*.mdb|All Files (*.*)|*.*"
  1219.    CMD1.DialogTitle = "Open MS Access Database to Compact"
  1220.    CMD1.FilterIndex = 1
  1221.    CMD1.Action = 1
  1222.    If CMD1.Filename <> "" Then
  1223.      oldname = CMD1.Filename
  1224.    Else
  1225.      Exit Sub
  1226.    End If
  1227.  
  1228.    'get file name to compact to
  1229.    CMD1.DialogTitle = "Select MS Access Database to Compact to"
  1230.    CMD1.FilterIndex = 1
  1231.    CMD1.Action = 2
  1232.    If CMD1.Filename <> "" Then
  1233.      newname = CMD1.Filename
  1234.    Else
  1235.      Exit Sub
  1236.    End If
  1237.  
  1238.    SetHourGlass Me
  1239.    MsgBar "Compacting " + oldname + " to " + newname, True
  1240.    CompactDatabase oldname, newname, DB_CREATE_GENERAL, DB_VERSION10
  1241.    MsgBar "", False
  1242.    ResetMouse Me
  1243.  
  1244.    If MsgBox("Open Newly Compacted Database?", MSGBOX_TYPE) = YES Then
  1245.      If gfDBOpenFlag = True Then
  1246.        Call DBClose_Click
  1247.      End If
  1248.      gstDataType = "MS Access"
  1249.      gstDBName = newname
  1250.      OpenLocalDB True
  1251.    End If
  1252.  
  1253.    If gfDBOpenFlag = True Then
  1254.      DBProperties.Visible = True
  1255.      DBClose.Visible = True
  1256.      TblMenu.Visible = True
  1257.      UtilMenu.Visible = True
  1258.      RefreshTables fTables.cTableList, True
  1259.      fSQL.CreateQueryDefbtn.Visible = True
  1260.      TblAttach.Visible = True
  1261.    End If
  1262.   
  1263.   GoTo CompactAccEnd
  1264. CompactAccErr:
  1265.   MsgBar "", False
  1266.   ResetMouse Me
  1267.   ShowError
  1268.   Resume CompactAccEnd
  1269.  
  1270. CompactAccEnd:
  1271.  
  1272. End Sub
  1273.  
  1274. Sub UtilExport_Click ()
  1275.   Dim ds As Dynaset
  1276.   Dim l As Long
  1277.   Dim i As Integer
  1278.   Dim fn As String
  1279.   Dim st As String
  1280.  
  1281.   On Error GoTo ExportErr
  1282.  
  1283.   If fTables.cTableList = "" And UCase(Mid(fSQL.cSQLStatement, 1, 6)) <> "SELECT" Then
  1284.     MsgBox "No Table Selected", 48
  1285.     Exit Sub
  1286.   End If
  1287.  
  1288.   fn = InputBox("Enter Path\FileName to Export to:", "Export File", "VISDATA.TXT")
  1289.  
  1290.   If fn = "" Then Exit Sub
  1291.  
  1292.   SetHourGlass Me
  1293.   MsgBar "Exporting Data to " + fn, True
  1294.  
  1295.   If UCase(Mid(fSQL.cSQLStatement, 1, 6)) = "SELECT" Then
  1296.     Set ds = gCurrentDB.CreateDynaset(fSQL.cSQLStatement)
  1297.   Else
  1298.     Set ds = gCurrentDB.CreateDynaset(fTables.cTableList)
  1299.   End If
  1300.  
  1301.   Open fn For Output As #1
  1302.  
  1303.   'output the field names
  1304.   st = Chr$(9)
  1305.   For i = 0 To ds.Fields.Count - 1
  1306.     st = st + ds(i).Name + Chr$(9)
  1307.   Next
  1308.   Print #1, st
  1309.  
  1310.   'output the field contents
  1311.   l = 1
  1312.   While ds.EOF = False
  1313.     st = CStr(l) + Chr$(9)
  1314.     For i = 0 To ds.Fields.Count - 1
  1315.       st = st + vFieldVal((ds(i))) + Chr$(9)
  1316.     Next
  1317.     Print #1, st
  1318.     ds.MoveNext
  1319.     l = l + 1
  1320.   Wend
  1321.  
  1322.   GoTo ExportEnd
  1323.  
  1324. ExportErr:
  1325.   ShowError
  1326.   Resume ExportEnd
  1327.  
  1328. ExportEnd:
  1329.   Close #1
  1330.   ResetMouse Me
  1331.   MsgBar "", False
  1332.  
  1333. End Sub
  1334.  
  1335. Sub UtilRepairDB_Click ()
  1336.    On Error GoTo RepairAccErr
  1337.    Dim nn As String
  1338.   
  1339.    'get file name to repair
  1340.    CMD1.Filter = "Access DBs (*.mdb)|*.mdb|All Files (*.*)|*.*"
  1341.    CMD1.DialogTitle = "Open MS Access Database to Repair"
  1342.    CMD1.FilterIndex = 1
  1343.    CMD1.Action = 1
  1344.    If CMD1.Filename <> "" Then
  1345.      nn = CMD1.Filename
  1346.    Else
  1347.      Exit Sub
  1348.    End If
  1349.  
  1350.    SetHourGlass Me
  1351.    MsgBar "Repairing " + nn, True
  1352.    RepairDatabase nn
  1353.    ResetMouse Me
  1354.    MsgBar "", False
  1355.  
  1356.    If MsgBox("Open Repaired Database?", MSGBOX_TYPE) = YES Then
  1357.      If gfDBOpenFlag = True Then
  1358.        Call DBClose_Click
  1359.      End If
  1360.      gstDataType = "MS Access"
  1361.      gstDBName = nn
  1362.      OpenLocalDB True
  1363.    End If
  1364.  
  1365.    If gfDBOpenFlag = True Then
  1366.      DBProperties.Visible = True
  1367.      DBClose.Visible = True
  1368.      TblMenu.Visible = True
  1369.      UtilMenu.Visible = True
  1370.      RefreshTables fTables.cTableList, True
  1371.      fSQL.CreateQueryDefbtn.Visible = True
  1372.      TblAttach.Visible = True
  1373.    End If
  1374.   
  1375.   GoTo RepairAccEnd
  1376. RepairAccErr:
  1377.   ResetMouse Me
  1378.   MsgBar "", False
  1379.   ShowError
  1380.   Resume RepairAccEnd
  1381.  
  1382. RepairAccEnd:
  1383.  
  1384. End Sub
  1385.  
  1386. Sub UtilReplace_Click ()
  1387.   Dim i As Integer
  1388.   Dim sb As String
  1389.  
  1390.   On Error GoTo ReplaceErr
  1391.  
  1392.   RefreshTables fReplace.cTableList, False
  1393.   fReplace.Show MODAL
  1394.  
  1395.   GoTo ReplaceEnd
  1396.  
  1397. ReplaceErr:
  1398.   ShowError
  1399.   Resume ReplaceEnd
  1400.  
  1401. ReplaceEnd:
  1402.  
  1403. End Sub
  1404.  
  1405. Sub WinArrange_Click ()
  1406.   Me.Arrange 3
  1407. End Sub
  1408.  
  1409. Sub WinCascade_Click ()
  1410.   Me.Arrange 0
  1411. End Sub
  1412.  
  1413. Sub WinSQL_Click ()
  1414.   fSQL.WindowState = 0
  1415. End Sub
  1416.  
  1417. Sub WinTables_Click ()
  1418.   fTables.WindowState = 0
  1419.   If fTables.cTableList.ListCount = 0 And gfDBOpenFlag = True Then
  1420.     RefreshTables fTables.cTableList, True
  1421.   End If
  1422. End Sub
  1423.  
  1424. Sub WinTile_Click ()
  1425.   Me.Arrange 2
  1426. End Sub
  1427.  
  1428.